home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / defoma-psfont-installer < prev    next >
Encoding:
Text File  |  2006-06-22  |  17.3 KB  |  836 lines
  1. #! /usr/bin/perl -w
  2. # Defoma - Debian Font Manager
  3. # Copyright (C) 2000 Yasuhiro Take <take@debian.org>
  4. # This program is free software. You can freely use, copy, modify, and
  5. # redistribute it under the terms of the GNU General Public License, Version 2.
  6.  
  7. use Debian::Defoma::Font;
  8. import Debian::Defoma::Font;
  9. use Debian::Defoma::Common;
  10. import Debian::Defoma::Common qw($DEFOMA_TEST_DIR USERSPACE $ROOTDIR);
  11.  
  12. exit 0 if (USERSPACE);
  13. #defoma_common_init();
  14.  
  15. $LIBDIR= "$DEFOMA_TEST_DIR/usr/share/defoma";
  16. $CONFDIR= "$DEFOMA_TEST_DIR/etc/defoma";
  17. $DATAFILE = "$LIBDIR/psprfonts.data";
  18. $DATAFILE2 = "$LIBDIR/psprfonts.data2";
  19. $CACHEFILE = "$ROOTDIR/psfontmgr.d/psprint.font-cache";
  20. $HINTFILE = "$ROOTDIR/psfontmgr.d/ps-hints.private-cache";
  21. $CEDATAFILE = "$CONFDIR/ps-cset-enc.data";
  22.  
  23. $PREFIX = 'pspr1';
  24.  
  25. @EXITREMOVE = ();
  26.  
  27. $SIG{'HUP'} = \&exitfunc;
  28. $SIG{'INT'} = \&exitfunc;
  29. $SIG{'QUIT'} = \&exitfunc;
  30. $SIG{'TERM'} = \&exitfunc;
  31. $SIG{'__DIE__'} = \&emes;
  32.  
  33. @CHARSET_LIST = ('Standard', 'Standard Roman charset.',
  34.          'Special', 'font-specific charset.',
  35.          'Adobe-Japan1', 'Japanese standard charsets.',
  36.          'Adobe-Japan2', 'Japanese extended charsets.',
  37.          'Adobe-Korea1', 'Korean charsets.',
  38.          'Adobe-CNS1', 'Traditional Chinese charsets.',
  39.          'Adobe-GB1', 'Simplified Chinese charsets.');
  40.  
  41. %FAMILY2GFAMILY_LIST = ();
  42.  
  43. $CUT = '/usr/bin/cut';
  44.  
  45. require("$LIBDIR/libperl-hint.pl");
  46.  
  47. sub exitfunc {
  48.     my $e = (@_ > 0) ? shift(@_) : 0;
  49.     $e = 0 if ($e =~ /[^0-9]/);
  50.     
  51.     unlink @EXITREMOVE if (@EXITREMOVE);
  52.     exit $e;
  53. }
  54.  
  55. sub emes {
  56.     my $msg = shift;
  57.     print 'defoma-psfont-installer: ', $msg, "\n";
  58.     exitfunc 1;
  59. }
  60.  
  61. my $RETCHARSET;
  62. my $RETENCODING;
  63.  
  64. my @STANDARD_LINES;
  65.  
  66. sub read_standard {
  67.     my $lcharset;
  68.     my $lencoding;
  69.     my $lscharset;
  70.     my $lsencoding;
  71.  
  72.     open(F, $CEDATAFILE) || return 0;
  73.     
  74.     while (<F>) {
  75.     chomp($_);
  76.     
  77.     next if ($_ eq '' || $_ =~ /^\#/);
  78.     
  79.     my @list = split(/[ \t]+/, $_);
  80.     next if (@list < 3);
  81.     next if ($list[0] eq '');
  82.     
  83.     push(@STANDARD_LINES, join(' ', @list));
  84.     }
  85.     
  86.     close F;
  87.     
  88.     return 0;
  89. }
  90.  
  91. sub get_standard {
  92.     my $acharset = shift;
  93.     my $aencoding = shift;
  94.  
  95.     $RETCHARSET = $RETENCODING = '';
  96.  
  97.     my $line;
  98.     foreach (@STANDARD_LINES) {
  99.     $line = $_;
  100.     my @list = split(/[ \t]+/, $line);
  101.  
  102.     my $lcharset = $list[0];
  103.     my $lencoding = $list[1];
  104.     my $lscharset = $list[2];
  105.     my $lsencoding = (@list > 3) ? $list[3] : '';
  106.  
  107.     $lcharset =~ s/\*/\.\*/g;
  108.     $lcharset =~ s/\?/\./g;
  109.  
  110.     $lencoding =~ s/\*/\.\*/g;
  111.     $lencoding =~ s/\?/\./g;
  112.  
  113.     if ($acharset =~ /^($lcharset)$/ && $aencoding =~ /^($lencoding)$/) {
  114.         $RETCHARSET = $lscharset;
  115.         $RETENCODING = $lsencoding;
  116.  
  117.         return 1;
  118.     }
  119.     }
  120.  
  121.     return 0;
  122. }
  123.  
  124. sub get_standard_list {
  125.     my $acharset = shift;
  126.     my @ret = ();
  127.     my $line;
  128.     
  129.     foreach (@STANDARD_LINES) {
  130.     $line = $_;
  131.     my @list = split(/[ \t]+/, $line);
  132.  
  133.     next if ($list[2] eq 'ignore');
  134.  
  135.     my $lcharset = $list[0];
  136.     my $lscharset = $list[2];
  137.     if (@list > 3) {
  138.         $lscharset .= ' ';
  139.         $lscharset .= $list[3];
  140.     }
  141.  
  142.     $lcharset =~ s/\*/\.\*/g;
  143.     $lcharset =~ s/\?/\./g;
  144.  
  145.     if (! $acharset || $acharset =~ /^($lcharset)$/) {
  146.         push(@ret, $lscharset);
  147.     }
  148.     }
  149.  
  150.     return @ret;
  151. }
  152.  
  153. my @HINTTYPE = qw(Family GeneralFamily Weight Width Shape PSCharset
  154.           PSEncoding Direction);
  155.  
  156. my @HINTFILE_DATA;
  157. my @DATAFILE_DATA;
  158. my @DATAFILE2_DATA;
  159.  
  160. sub clear_hints {
  161.     my $hashptr = shift;
  162.     
  163.     foreach my $i (@HINTTYPE) {
  164.     $$hashptr{$i} = '';
  165.     }
  166. }
  167.  
  168. sub parse_hints {
  169.     my $hashptr = shift;
  170.     my $pattern = join('|', @HINTTYPE);
  171.     my $i;
  172.  
  173.     clear_hints($hashptr);
  174.  
  175.     while (@_ > 0) {
  176.     $i = shift;
  177.  
  178.     if ($i =~ /^--($pattern)$/) {
  179.         $i = $1;
  180.  
  181.         while (@_ > 0) {
  182.         my $j = shift;
  183.  
  184.         if ($j =~ /^--/) {
  185.             unshift(@_, $j);
  186.             last;
  187.         }
  188.         
  189.         if ($i =~ /^(Shape|Weight)$/) {
  190.             $$hashptr{$i} .= ' ' if ($$hashptr{$i} ne '');
  191.             $$hashptr{$i} .= $j;
  192.         } else {
  193.             $$hashptr{$i} = $j;
  194.         }
  195.         }
  196.     }
  197.     }
  198. }
  199.  
  200. sub read_hints {
  201.     if (open(F, $HINTFILE)) {
  202.     while (<F>) {
  203.         chomp($_);
  204.         push(@HINTFILE_DATA, $_);
  205.     }
  206.     close F;
  207.     }
  208.     if (open(F, $DATAFILE)) {
  209.     while (<F>) {
  210.         chomp($_);
  211.         push(@DATAFILE_DATA, $_);
  212.     }
  213.     close F;
  214.     }
  215.     if (open(F, $DATAFILE2)) {
  216.     while (<F>) {
  217.         chomp($_);
  218.         push(@DATAFILE2_DATA, $_);
  219.     }
  220.     close F;
  221.     }
  222.  
  223.     for my $i (@HINTFILE_DATA, @DATAFILE_DATA, @DATAFILE2_DATA) {
  224.     my @list = split(' ', $i);
  225.     my %hints = ();
  226.     parse_hints(\%hints, @list);
  227.  
  228.     if ($hints{'Family'} ne '' && $hints{'GeneralFamily'} ne '') {
  229.         $FAMILY2GFAMILY_LIST{$hints{'Family'}} = $hints{'GeneralFamily'};
  230.     }
  231.     }
  232. }
  233.  
  234. sub get_not_registered_font {
  235.     my %list = ();
  236.     my $psfontname;
  237.     my @ret = ();
  238.  
  239.     foreach (@DATAFILE_DATA) {
  240.     $psfontname = $_;
  241.     $psfontname =~ s/^([^ ]+).*/$1/;
  242.     $list{$psfontname} = 1;
  243.     }
  244.  
  245.     foreach (@HINTFILE_DATA) {
  246.     $psfontname = $_;
  247.     $psfontname =~ s/^([^ ]+).*/$1/;
  248.     $list{$psfontname} = 1;
  249.     }
  250.  
  251.     if (open(F, $CACHEFILE)) {
  252.     while (<F>) {
  253.         $psfontname = $_;
  254.         chomp($psfontname);
  255.         $psfontname =~ s/^([^ ]+).*/$1/;
  256.         if ($psfontname =~ /^$PREFIX\//) {
  257.         delete($list{$'});
  258.         }
  259.     }
  260.     close F;
  261.     }
  262.  
  263.     @ret = sort (keys(%list));
  264.  
  265.     return @ret;
  266. }
  267.  
  268. sub get_hints {
  269.     my $font = shift;
  270.     my $pscharset = shift;
  271.     my $psencoding = shift;
  272.     my $hashptr = shift;
  273.     my $tmp;
  274.     
  275.     my @list;
  276.  
  277.     my $line;
  278.     foreach (@HINTFILE_DATA) {
  279.     $line = $_;
  280.     @list = split(' ', $line);
  281.     if ($list[0] eq $font) {
  282.         $tmp = shift(@list);
  283.         parse_hints($hashptr, @list);
  284.         unless ($$hashptr{'Charset'}) {
  285.         $$hashptr{'PSCharset'} = $pscharset;
  286.         $$hashptr{'PSEncoding'} = $psencoding;
  287.         }
  288.         
  289.         return 1;
  290.     }
  291.     }
  292.  
  293.     foreach (@DATAFILE_DATA) {
  294.     $line = $_;
  295.     @list = split(' ', $line);
  296.     
  297.     if ($list[0] eq $font) {
  298.         $tmp = shift(@list);
  299.         $pscharset = shift(@list);
  300.         $psencoding = shift(@list);
  301.         parse_hints($hashptr, @list);
  302.         $$hashptr{'PSCharset'} = $pscharset;
  303.         $$hashptr{'PSEncoding'} = $psencoding;
  304.  
  305.         return 1;
  306.     }
  307.     }
  308.  
  309.     foreach (@DATAFILE2_DATA) {
  310.     $line = $_;
  311.     
  312.     @list = split(' ', $line);
  313.     $list[0] =~ s/\*/\.\*/g;
  314.     $list[0] =~ s/\?/\./g;
  315.     
  316.     if ($font =~ /^($list[0])$/) {
  317.         $tmp = shift(@list);
  318.         parse_hints($hashptr, @list);
  319.         $$hashptr{'PSCharset'} = $pscharset;
  320.         $$hashptr{'PSEncoding'} = $psencoding;
  321.  
  322.         return 1;
  323.     }
  324.     }
  325.  
  326.     return 0;
  327. }
  328.  
  329. my $PSCHARSET;
  330. my $PSENCODING;
  331.  
  332. sub input_ps_charset_encoding {
  333.     my $font = shift;
  334.     my $defcset = shift;
  335.     my $defenc = shift;
  336.     my $text;
  337.     my $pscharset;
  338.     my $psencoding = '';
  339.  
  340.     $PSCHARSET = '';
  341.     $PSENCODING = '';
  342.  
  343.     $text = <<EOF
  344. Choose the PostScript Charset of $font.
  345. * PostScript Charset is just temporarilly used for deciding (National)
  346. * Standard Charset and Encoding according /etc/defoma/ps-cmap-enc.data.
  347. EOF
  348.     ;
  349.  
  350.     $pscharset = input_menu2("Input the PostScript Charset of $font.",
  351.                  $defcset, '[^ ]', 0, '<None>', $text,
  352.                  @CHARSET_LIST, '<None>', ' ');
  353.     return if ($result != 0);
  354.  
  355.     if ($pscharset =~ /^(Standard|Special)$/) {
  356.     $psencoding = $pscharset;
  357.     } else {
  358.     my $cmaplist = '';
  359.     my $cmapfile = "$ROOTDIR/psfontmgr.d/$pscharset.cmaps.private-cache";
  360.     
  361.     if (-f $cmapfile) {
  362.         $cmaplist = `$CUT -d ' ' -f 1 $cmapfile`;
  363.     } elsif (-f ($cmapfile = "$LIBDIR/$pscharset.default-cmap")) {
  364.         $cmaplist = `/bin/cat $cmapfile`;
  365.     }
  366.     
  367.     if ($cmaplist ne '') {
  368.         $text = <<EOF
  369. Choose the CMap of $font.
  370. * CMap represents the charsets, encoding and direction of a font, and
  371. * it is often equivalent to the FontName which the Family and some
  372. * Subfamilies removed from. For example, GothicBBB-Medium-78-EUC-H is
  373. * a font whose Family is GothicBBB and Weight is Medium. Its CMap is
  374. * 78-EUC-H, which means it is JIS-78 charset, EUC encoding, Horizontal
  375. * direction.
  376. EOF
  377.     ;
  378.         $psencoding =input_menu("Input the CMap of $font.",
  379.                     $defenc, '[^ ]', 0, '<None>', $text,
  380.                     split(/\n/, $cmaplist), '<None>');
  381.     } else {
  382.         $psencoding = input_menu("Input the Encoding of $font.",
  383.                      $defenc, '[^ ]', 0);
  384.     }
  385.     return if ($result != 0);
  386.     }
  387.  
  388.     $PSCHARSET = $pscharset;
  389.     $PSENCODING = $psencoding;
  390.  
  391.     return;
  392. }
  393.  
  394. my $S_CHARSET;
  395. my $S_ENCODING;
  396.  
  397. sub get_charset_encoding {
  398.     my $font = shift;
  399.     my $pscharset = shift;
  400.     my $psencoding = shift;
  401.     my $text;
  402.     my $charset = '';
  403.     my $encoding = '';
  404.  
  405.     $S_CHARSET = '';
  406.     $S_ENCODING = '';
  407.  
  408.     if (get_standard($pscharset, $psencoding) == 0) {
  409.     $text = <<EOF
  410. In processing $font:
  411. No Standard Charset/Encoding is found that matches the pair of 
  412. $pscharset/$psencoding in /etc/defoma/ps-cmap-enc.data. Choose the 
  413. Standard Charset/Encoding from the following list of ones that matches
  414. the PostScript Charset.
  415. EOF
  416.     ;
  417.     my $text2 = <<EOF
  418. In processing $font:
  419. No Standard Charset/Encoding is found that matches the pair of 
  420. $pscharset/$psencoding in /etc/defoma/ps-cmap-enc.data. 
  421. Input the Standard Charset and Encoding manually separating by space. 
  422. If multiple charsets corresponds, separate them by comma. Encoding is not 
  423. required to input. 
  424. Ex.\) JISX0208,JISX0201 EUC (JISX0208 & 0201 are Charset, EUC is encoding.)
  425. EOF
  426.     ;
  427.     my @list = get_standard_list($pscharset);
  428.     push (@list, '<None>') if (@list > 0);
  429.     
  430.     my $ret = input_menu($text2, '', '.', 0, '<None>', $text, @list);
  431.     return 0 if ($result != 0);
  432.     
  433.     @list = split(' ', $ret);
  434.  
  435.     $charset = $list[0];
  436.     $encoding = $list[1] if (@list > 1);
  437.     } else {
  438.     $charset = $RETCHARSET;
  439.     $encoding = $RETENCODING;
  440.     }
  441.  
  442.     $charset =~ s/,/ /g;
  443.  
  444.     $S_CHARSET = $charset;
  445.     $S_ENCODING = $encoding;
  446.  
  447.     return 1;
  448. }
  449.  
  450. sub get_generalfamily {
  451.     my $font = shift;
  452.     my $family = shift;
  453.     my %hints;
  454.     my $ret;
  455.  
  456.     if (exists($FAMILY2GFAMILY_LIST{$family})) {
  457.     $result = 0;
  458.     return $FAMILY2GFAMILY_LIST{$family};
  459.     }
  460.  
  461.     $ret = input_generalfamily($font, '');
  462.     return if ($result != 0);
  463.  
  464.     $FAMILY2GFAMILY_LIST{$family} = $ret;
  465. }
  466.  
  467. sub create_hintslines {
  468.     my $font = shift;
  469.     my $hintsptr = shift;
  470.     my $verbose = shift;
  471.  
  472.     my $pcset = $$hintsptr{'PSCharset'};
  473.     my $penc = $$hintsptr{'PSEncoding'};
  474.     
  475.     my $text = <<EOF
  476. In processing $font:
  477. Charset: $pcset
  478. Encoding: $penc
  479.  
  480. Specified PostScript Charset/Encoding ($pcset/$penc) of this font
  481. is marked as 'ignore' according to /etc/defoma/ps-cset-enc.data.
  482. $font is not registered anyway.
  483. EOF
  484.     ;
  485.  
  486.     unless ($$hintsptr{'Charset'}) {
  487.     get_charset_encoding($font, $pcset, $penc);
  488.     return if ($result != 0);
  489.     
  490.     if ($S_CHARSET eq 'ignore') {
  491.         if ($verbose != 0) {
  492.         msgbox($text);
  493.         }
  494.         return '';
  495.     }
  496.     
  497.     $$hintsptr{'Charset'} = $S_CHARSET;
  498.     $$hintsptr{'Encoding'} = $S_ENCODING;
  499.     }
  500.  
  501.     $hints = "begin $PREFIX/$font\n";
  502.     
  503.     foreach my $key (keys(%{$hintsptr})) {
  504.     if ($$hintsptr{$key} ne '') {
  505.         $hints .= "  $key = $$hintsptr{$key}\n";
  506.     }
  507.     }
  508.  
  509.     $hints .= "end\n";
  510.  
  511.     return $hints;
  512. }
  513.  
  514. sub new_font {
  515.     my $verbose = shift;
  516.     my $font = shift;
  517.     my $pscharset = shift;
  518.     my $psencoding = shift;
  519.     my $hintflag = '';
  520.  
  521.     my %hints = ();
  522.     clear_hints(\%hints);
  523.     
  524.     if (get_hints($font, $pscharset, $psencoding, \%hints)) {
  525.     $hintflag = '--RegisteredHints';
  526.  
  527.     if ($hints{'Direction'} eq '') {
  528.         $hints{'Direction'} = 'Horizontal';
  529.         $hints{'Direction'} = 'Vertical' if ($font =~ /^.*-V$/);
  530.     }
  531.     } else {
  532.     $hintflag = '--AssumedHints';
  533.     
  534.     $hints{'PSCharset'} = $pscharset;
  535.     $hints{'PSEncoding'} = $psencoding;
  536.     $hints{'Family'} = $font;
  537.     $hints{'Family'} =~ s/^([^-]+).*$/$1/;
  538.     
  539.     $hints{'Direction'} = 'Horizontal';
  540.     $hints{'Direction'} = 'Vertical' if ($font =~ /^.*-V$/);
  541.     
  542.     $hints{'Weight'} = 'Medium';
  543.     $hints{'Weight'} = 'Bold' if ($font =~ /Bold/);
  544.     $hints{'Weight'} = 'Semibold' if ($font =~ /Semibold/);
  545.     $hints{'Weight'} = 'Semibold' if ($font =~ /Demi/);
  546.     $hints{'Weight'} = 'Light' if ($font =~ /Light/);
  547.     
  548.     $hints{'Width'} = 'Variable';
  549.     
  550.     my $slant = 'Upright';
  551.     my $serif = 'Serif';
  552.     my $swidth = '';
  553.     
  554.     $slant = 'Oblique Italic' if ($font =~ /Italic/);
  555.     $slant = 'Oblique' if ($font =~ /Obli/);
  556.     
  557.     $swidth = 'Condensed' if ($font =~ /Narrow|Condensed/);
  558.     $swidth = 'Expanded' if ($font =~ /Expanded/);
  559.     
  560.     my $gfamily = get_generalfamily($font, '');
  561.     return if ($result != 0);
  562.     
  563.     $serif = 'NoSerif' if ($gfamily eq 'SansSerif');
  564.     $hints{'Width'} = 'Fixed' if ($gfamily eq 'Typewriter');
  565.     
  566.     $hints{'Shape'} = "$slant $serif";
  567.     $hints{'Shape'} .= " $swidth" if ($swidth ne '');
  568.     
  569.     if ($gfamily eq 'Symbol') {
  570.         $hints{'PSCharset'} = $hints{'PSEncoding'} = 'Special';
  571.         $hints{'Weight'} = '';
  572.         $hints{'Width'} = '';
  573.         $hints{'Shape'} = '';
  574.     }
  575.     
  576.     $hints{'GeneralFamily'} = $gfamily;
  577.     }
  578.  
  579.     return create_hintslines($font, \%hints, $verbose);
  580. }
  581.         
  582. ### ----------- register --------------
  583.  
  584. @HINTFILE = ();
  585. @SKIPPED = ();
  586.  
  587. sub com_register_1 {
  588.     my $verbose = shift;
  589.     my $ppdfileptr = shift;
  590.     
  591.     my $text = <<EOF
  592. If you have the PPD (Postscript Printer Description) file for your 
  593. PS Printer, select the file. Otherwise choose Cancel.
  594. EOF
  595.     ;
  596.     my $ppdfile = fileselector($text);
  597.     
  598.     $$ppdfileptr = $ppdfile;
  599.     return $result;
  600. }
  601.  
  602. sub com_register_2a {
  603.     my $verbose = shift;
  604.     my $ppdfile = shift;
  605.  
  606.     my $font;
  607.     my $charset;
  608.     my $encoding;
  609.     my $hints;
  610.     my @list;
  611.     
  612.     my $tempfile = `/bin/tempfile`;
  613.     chomp($tempfile);
  614.     push(@EXITREMOVE, $tempfile);
  615.     
  616.     system("/bin/cat '$ppdfile' | /usr/bin/tr '\\r' '\\n' > $tempfile");
  617.     
  618.     if (open(F, $tempfile)) {
  619.     while (<F>) {
  620.         my $line = $_;
  621.         chomp($line);
  622.         
  623.         if ($line =~ /^\*Font /) {
  624.         @list = split(' ', $line);
  625.         
  626.         $font = $list[1];
  627.         $font =~ s/:$//;
  628.         
  629.         next if ($font =~ /[^a-zA-Z0-9.-]/);
  630.         
  631.         $encoding = $list[2];
  632.         $charset = $list[4];
  633.  
  634.         $hints = new_font($verbose, $font, $charset, $encoding);
  635.         return $result if ($result != 0);
  636.  
  637.         if ($hints ne '') {
  638.             push(@HINTFILE, $hints);
  639.         } else {
  640.             push(@SKIPPED, $font);
  641.         }
  642.         }
  643.     }
  644.     close F;
  645.     }
  646.  
  647.     unlink($tempfile);
  648.     $tempfile = pop(@EXITREMOVE);
  649.  
  650.     return 0;
  651. }
  652.  
  653. sub com_register_2b {
  654.     my $verbose = shift;
  655.  
  656.     my $font;
  657.     my $hints;
  658.     my @list;
  659.     my $text;
  660.     
  661.     @list = get_not_registered_font();
  662.     
  663.     if (@list > 0) {
  664.     $text = <<EOF
  665. Mark fonts you want to register as installed in you PS Printer.
  666. Use SPACE key to toggle the mark on/off.
  667. EOF
  668.     ;
  669.     $ret = checklist_single_onargs($text, 10, '', @list);
  670.     return $result if ($result != 0);
  671.     
  672.     @list = split(/\n/, $ret);
  673.     foreach (@list) {
  674.         $font = $_;
  675.         $hints = new_font($verbose, $font, 0, 0);
  676.         return $result if ($result != 0);
  677.  
  678.         if ($hints ne '') {
  679.         push(@HINTFILE, $hints);
  680.         } else {
  681.         push(@SKIPPED, $font);
  682.         }
  683.     }
  684.     }
  685.  
  686.     return 0;
  687. }
  688.  
  689. sub com_register_3b {
  690.     my $verbose = shift;
  691.     
  692.     my $text = <<EOF
  693. If your PS Printer has other fonts that did not appear in the
  694. previous list, and you can input the name, charset and encoding
  695. of them, answer Yes. Otherwise answer No.
  696. EOF
  697.     ;
  698.  
  699.     my $font;
  700.     my $charset;
  701.     my $encoding;
  702.     my $hints;
  703.     my @list;
  704.     my $ret;
  705.     
  706.     if (yesnobox($text) == 0) {
  707.     while (1) {
  708.         $text = 'Input the name of the font manually. (Courier-Bold)';
  709.         $ret = input_menu($text, '', '[a-zA-Z0-9.-]', 0, '');
  710.         last if ($result == 1);
  711.         return $result if ($result != 0);
  712.         $font = $ret;
  713.         
  714.         input_ps_charset_encoding($font, '', '');
  715.         next if ($result != 0);
  716.  
  717.         $hints = new_font($verbose, $font, $PSCHARSET, $PSENCODING);
  718.         next if ($result != 0);
  719.  
  720.         if ($hints ne '') {
  721.         push(@HINTFILE, $hints);
  722.         } else {
  723.         push(@SKIPPED, $font);
  724.         }
  725.  
  726.         last if (yesnobox("Do you want to continue registering?") != 0);
  727.     }
  728.     }
  729.  
  730.     return 0;
  731. }
  732.  
  733. sub com_register {
  734.     my $ppdfile;
  735.     my $verbose = 0;
  736.     my $text;
  737.  
  738.     my $ret = com_register_1($verbose, \$ppdfile);
  739.     if ($ret == 0) {
  740.     $ret = com_register_2a($verbose, $ppdfile);
  741.     exitfunc(1) if ($ret);
  742.     } elsif ($ret == 1) {
  743.     $ret = com_register_2b($verbose);
  744.     exitfunc(1) if ($ret);
  745.  
  746.     $ret = com_register_3b($verbose);
  747.     exitfunc(1) if ($ret);
  748.     } else {
  749.     exitfunc(1);
  750.     }
  751.  
  752.     if (@HINTFILE > 0) {
  753.     my $file = "$DEFOMA_TEST_DIR/etc/defoma/hints/defoma-ps.hints";
  754.     
  755.     unless (open(F, ">$file")) {
  756.         $text = <<EOF
  757. You don\'t have a write permission in /etc/defoma/hints.
  758. Please become root and run defoma-psfont-installer again.
  759. EOF
  760.     ;
  761.         msgbox($text);
  762.         exitfunc(1);
  763.     }
  764.  
  765.     $text = <<EOF
  766. # List of PostScript Fonts Installed in the PS Printer with Hints.
  767. # After modifying this file, run 
  768. #   defoma-font reregister-all $file
  769. category psprint
  770. EOF
  771.     ;
  772.     print F $text;
  773.     print F @HINTFILE;
  774.     close F;
  775.  
  776.     my $text = <<EOF
  777. Done. The hintfile for PostScript Printer fonts is created as:
  778. $file. 
  779. You can change the hints of the fonts by editting the file.
  780. EOF
  781.     ;
  782.     my $command = "/usr/bin/defoma-font reregister-all $file";
  783.  
  784.     if ($NOOUTPUT) {
  785.         infobox("Registering fonts...");
  786.         system("$command > /dev/null 2>&1");
  787.         msgbox($text);
  788.     } else {
  789.         print "Registering fonts...\n";
  790.         system($command);
  791.         print $text;
  792.     }
  793.     } else {
  794.     if ($NOOUTPUT) {
  795.         msgbox("No font gets registered. ");
  796.     } else {
  797.         print("No font gets registered. ");
  798.     }
  799.     }
  800. }
  801.  
  802. sub note {
  803.     my $text = <<EOF
  804. defoma-psfont-installer is a tool to register PostScript fonts
  805. installed in a PostScript printer to Defoma. It is strongly
  806. recommended for you to have the PPD file ready, but not required.
  807. EOF
  808.     ;
  809.  
  810.     msgbox($text);
  811.     return 0;
  812. }
  813.  
  814. $DWIDTH = 70;
  815. $DIALOGTITLE = 'PostScript Font Manager';
  816. $NOOUTPUT = 0;
  817. $MODE = 'g';
  818.  
  819. while (@ARGV > 0) {
  820.     my $s = shift(@ARGV);
  821.     $NOOUTPUT = 1 if ($s eq '--no-output');
  822.     $MODE = 'c' if ($s eq '-c');
  823. }
  824.  
  825. defoma_font_init();
  826. hint_beginlib($DIALOGTITLE, $DWIDTH, $MODE);
  827. read_hints();
  828. read_standard();
  829.  
  830. note();
  831. com_register();
  832.  
  833. exitfunc(0);
  834.  
  835.  
  836.